; [7] Mapping function and non-local variable access

; **** BITA ****

(SETQ BASE 10. IBASE 10.)

(DEFUN BITA (A)
  (COND ((NULL (CDR A)) A)
        ((NULL (CDDR A)) (LIST (CONS (CAR A) (CONS '$ (CDR A)))))
        (T (BITL (CDR A) (LIST (CAR A)))) ))

(DEFUN BITL (X J)
  (COND ((NULL X) NIL)
        (T (NCONC
            (MAPCAN
             (FUNCTION
              (LAMBDA (K)
                (MAPCAR
                 (FUNCTION
                  (LAMBDA (L)
                    (LIST L '$ K) ))
                 (BITA J) )))
             (BITA X))
            (BITL (CDR X) (APPEND J (LIST (CAR X)))) ))))

; **** BITB ****

(DECLARE (SPECIAL AA))

(DEFUN BITB (AA)                 ; AA is non-local.
  (COND ((NULL AA) NIL)
        ((NULL (CDR AA)) AA)
        (T ((LAMBDA (C)
              (SETQ AA (LIST (CAR AA) '$ (CADR AA)))
              (MAPCON
               (FUNCTION (LAMBDA (B) (G (CAR B))))
               (BITB (CDR C))) )
            AA )
           )))

(DEFUN G (B)
  (COND ((ATOM B) (LIST AA))     ; AA is defined in bitb
        (T (CONS (LIST (CAR AA) '$ B)
                 (MAPCAR
                  (FUNCTION (LAMBDA (AA) (CONS AA (CDR B))))
                  (G (CAR B)) )))))

(DEFMACRO BENCHMARK (N &REST BODY)
  `(LET (TIME1 TIME2 TIME3 GC RUN)
     (SSTATUS GCTIME 0)
     (SETQ TIME1 (RUNTIME))
     (DO ((I 1 (1+ I)))
	 ((> I ,N))
       ,@BODY )
     (SETQ TIME2 (RUNTIME))
     (DO ((I 1 (1+ I))) ((> I ,N)))
     (SETQ TIME3 (RUNTIME))
     (SETQ GC (STATUS GCTIME))
     (SETQ RUN (DIFFERENCE (PLUS TIME2 TIME2) TIME1 TIME3))
     (TERPRI)
     (PRINC "Total = ")
     (PRINC RUN)
     (PRINC "us, Runtime = ")
     (PRINC (DIFFERENCE RUN GC))
     (PRINC "us, GC = ")
     (PRINC GC)
     (PRINC "us, for ")
     (PRINC ,N)
     (PRINC " iterations.")
     (TERPRI)
     ))

; [7-1:] BITA-5
(DEFUN BENCH71 (ITER) (BENCHMARK ITER (BITA '(A B C D E))))
; [7-2:] BITA-6
(DEFUN BENCH72 (ITER) (BENCHMARK ITER (BITA '(A B C D E F))))
; [7-3:] BITB-5
(DEFUN BENCH73 (ITER) (BENCHMARK ITER (BITB '(A B C D E))))
; [7-4:] BITB-6
(DEFUN BENCH74 (ITER) (BENCHMARK ITER (BITB '(A B C D E F))))

; If macro is not avaiable, use instead the followings:

'("*** Please this line and the last line. ***"

(DEFUN BENCH71 (ITER)
  (PROG (TIME1 TIME2 TIME3 GC RUN N)
	(SSTATUS GCTIME 0)
	(SETQ TIME1 (RUNTIME))
	(SETQ N ITER)
   L1   (BITA '(A B C D E))
	(COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO L1)))
	(SETQ TIME2 (RUNTIME))
	(SETQ N ITER)
   L2   (COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO L2)))
	(SETQ TIME3 (RUNTIME))
	(SETQ GC (STATUS GCTIME))
	(SETQ RUN (DIFFERENCE (PLUS TIME2 TIME2) TIME1 TIME3))
	(TERPRI)
	(PRINC "Total = ")
	(PRINC RUN)
	(PRINC "us,  Runtime = ")
	(PRINC (DIFFERENCE RUN GC))
	(PRINC "us, GC = ")
	(PRINC GC)
	(PRINC "us, for ")
	(PRINC ITER)
	(PRINC " iterations.")
	(TERPRI)
        ))

(DEFUN BENCH72 (ITER)
  (PROG (TIME1 TIME2 TIME3 GC RUN N)
	(SSTATUS GCTIME 0)
	(SETQ TIME1 (RUNTIME))
	(SETQ N ITER)
   L1   (BITA '(A B C D E F))
	(COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO L1)))
	(SETQ TIME2 (RUNTIME))
	(SETQ N ITER)
   L2   (COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO L2)))
	(SETQ TIME3 (RUNTIME))
	(SETQ GC (STATUS GCTIME))
	(SETQ RUN (DIFFERENCE (PLUS TIME2 TIME2) TIME1 TIME3))
	(TERPRI)
	(PRINC "Total = ")
	(PRINC RUN)
	(PRINC "us,  Runtime = ")
	(PRINC (DIFFERENCE RUN GC))
	(PRINC "us, GC = ")
	(PRINC GC)
	(PRINC "us, for ")
	(PRINC ITER)
	(PRINC " iterations.")
	(TERPRI)
        ))

(DEFUN BENCH73 (ITER)
  (PROG (TIME1 TIME2 TIME3 GC RUN N)
	(SSTATUS GCTIME 0)
	(SETQ TIME1 (RUNTIME))
	(SETQ N ITER)
   L1   (BITB '(A B C D E))
	(COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO L1)))
	(SETQ TIME2 (RUNTIME))
	(SETQ N ITER)
   L2   (COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO L2)))
	(SETQ TIME3 (RUNTIME))
	(SETQ GC (STATUS GCTIME))
	(SETQ RUN (DIFFERENCE (PLUS TIME2 TIME2) TIME1 TIME3))
	(TERPRI)
	(PRINC "Total = ")
	(PRINC RUN)
	(PRINC "us,  Runtime = ")
	(PRINC (DIFFERENCE RUN GC))
	(PRINC "us, GC = ")
	(PRINC GC)
	(PRINC "us, for ")
	(PRINC ITER)
	(PRINC " iterations.")
	(TERPRI)
        ))

(DEFUN BENCH74 (ITER)
  (PROG (TIME1 TIME2 TIME3 GC RUN N)
	(SSTATUS GCTIME 0)
	(SETQ TIME1 (RUNTIME))
	(SETQ N ITER)
   L1   (BITB '(A B C D E F))
	(COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO L1)))
	(SETQ TIME2 (RUNTIME))
	(SETQ N ITER)
   L2   (COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO L2)))
	(SETQ TIME3 (RUNTIME))
	(SETQ GC (STATUS GCTIME))
	(SETQ RUN (DIFFERENCE (PLUS TIME2 TIME2) TIME1 TIME3))
	(TERPRI)
	(PRINC "Total = ")
	(PRINC RUN)
	(PRINC "us,  Runtime = ")
	(PRINC (DIFFERENCE RUN GC))
	(PRINC "us, GC = ")
	(PRINC GC)
	(PRINC "us, for ")
	(PRINC ITER)
	(PRINC " iterations.")
	(TERPRI)
        ))
"*** Please kill this line. ***" )

; Now measure the benchmark.

; (BENCH71 10. )
; (BENCH72 10. )
; (BENCH73 10. )
; (BENCH74 10. )